Cream of the Crop 1/Cream of the Crop 1.iso/UTILITY/TSRSRC34.ARJ/DISABLE.PAS

Pascal/Delphi Source File | 1992-02-14 | 19KB | 581 lines

{**************************************************************************
*   DISABLE - Activates or deactivates TSRs.                              *
*   Copyright (c) 1987,1991 Kim Kokkonen, TurboPower Software.            *
*   May be freely distributed and used but not sold except by permission. *
***************************************************************************
*   version 2.3 5/4/87                                                    *
*     first release. version number matches other TSR Utilities           *
*   :                                                                     *
*   long intervening history                                              *
*   :                                                                     *
*   version 3.0 9/24/91                                                   *
*     update for DOS 5                                                    *
*     add Quiet option                                                    *
*     add support for high memory                                         *
*   version 3.1 11/4/91                                                   *
*     update for new WATCH detection method                               *
*   version 3.2 11/22/91                                                  *
*     change method of accessing high memory                              *
*   version 3.3 1/8/92                                                    *
*     find TSRs by name just like MAPMEM does                             *
*     increase stack space                                                *
*     add /H to use high memory optionally                                *
*     new features for parsing and getting command line options           *
*   version 3.4 2/14/92                                                   *
*     add /L option to turn off low memory checking                       *
***************************************************************************
*   telephone: [phone], CompuServe: 76004,2611.                      *
*   requires Turbo Pascal version 6 to compile.                           *
***************************************************************************}

{$R-,S-,I-,V-,B-,F-,A-,E-,N-,G-,X-}
{$M 4096,0,655360}
{.$DEFINE MeasureStack}  {Activate to measure stack usage}

program DisableTSR;
  {-Deactivate and reactivate memory resident programs}
  {-Leaving them in memory all the while}

uses
  Dos,
  MemU;

var
  Blocks : BlockArray;
  BlockMax : BlockType;
  WatchPsp : Word;
  CommandSeg : Word;
  HiMemSeg : Word;
  Changes : ChangeArray;
  ChangeMax, ActualMax, PspHex, StartMCB : Word;
  Action : (aDeactivate, aActivate, aCheckFor);
  Override : Boolean;
  Quiet : Boolean;
  UseLoMem, OptUseHiMem, UseHiMem : Boolean;
  TsrName : PathStr;
  {$IFDEF MeasureStack}
  I : Word;
  {$ENDIF}

  procedure Abort(msg : String; ErrorLevel : Byte);
    {-Halt in case of error}
  begin
    WriteLn(msg);
    Halt(ErrorLevel);
  end;

  function ExecutableBlock(PspHex : Word) : Boolean;
    {-Return true if psphex corresponds to an executable code block}
  var
    b : BlockType;
  begin
    for b := BlockMax downto 1 do
      {Search back to find executable rather than environment block}
      if Blocks[b].psp = PspHex then begin
        ExecutableBlock := True;
        Exit;
      end;
    ExecutableBlock := False;
  end;

  procedure InitChangeArray(WatchPsp : Word);
    {-Initialize information regarding the WATCH data block}
  var
    watchindex : Word;
    p : ^ChangeBlock;
  begin
    {Maximum offset in WATCH data area}
    ActualMax := MemW[WatchPsp:NextChange];

    {Transfer changes from WATCH into a buffer array}
    watchindex := 0;
    ChangeMax := 0;
    while watchindex < ActualMax do begin
      p := Ptr(WatchPsp, ChangeVectors+watchindex);
      Move(p^, Changes[ChangeMax], SizeOf(ChangeBlock));
      Inc(watchindex, SizeOf(ChangeBlock));
      if watchindex < ActualMax then
        inc(ChangeMax);
    end;
  end;

  procedure PutWatch(chg : ChangeBlock; var watchindex : Word);
    {-Put a change block back into WATCH}
  var
    p : ^ChangeBlock;
  begin
    p := Ptr(WatchPsp, ChangeVectors+watchindex);
    Move(chg, p^, SizeOf(ChangeBlock));
    Inc(watchindex, SizeOf(ChangeBlock));
  end;

  procedure ActivateTSR(PspHex : Word);
    {-Patch out the active interrupt vectors of a specified TSR}
  var
    nextchg, chg, watchindex : Word;
    checking, didsomething : Boolean;
  begin
    didsomething := False;
    watchindex := 0;
    chg := 0;

    {Scan looking for the specified PSP}
    while chg <= ChangeMax do begin
      with Changes[chg] do
        case ID of

          $FF :               {This record starts a new PSP}
            begin
              checking := (PspAdd = PspHex);
              nextchg := Succ(chg);
              if checking then
                {Turn off interrupts}
                inline($FA)
              else
                {Turn on interrupts}
                inline($FB);
            end;

          $01 :               {This record has an inactive vector redefinition}
            if checking then begin
              {We're in the proper PSP}
              didsomething := True;
              {Change the ID to indicate that vector is active}
              ID := 0;
              {Put the original vector code back in place}
              nextchg := Succ(chg);
              if (Changes[nextchg].ID <> 2) or (Changes[nextchg].VecNum <> VecNum) then
                Abort('Program error in Activate, patch record not found', 255);
              {Restore the patched over code}
              Move(Changes[nextchg].SaveCode, Mem[VecSeg:VecOfs], 6);
              {Don't output the following patch record}
              inc(nextchg);
            end else
              nextchg := Succ(chg);

        else
          nextchg := Succ(chg);
        end;

      {Put the change block back into WATCH}
      PutWatch(Changes[chg], watchindex);
      {Advance to the next change record}
      chg := nextchg;
    end;

    {Store the count back into WATCH}
    MemW[WatchPsp:NextChange] := watchindex;

    if not(didsomething) then
      Abort('No changes were needed to activate '+HexW(PspHex), 1);

  end;

  procedure DeactivateTSR(PspHex : Word);
    {-Patch out the active interrupt vectors of a specified TSR}
  var
    newchange : ChangeBlock;
    chg, watchindex, curpsp : Word;
    putrec, checking, didsomething : Boolean;

    procedure PutPatch(vecn : Byte; vecs, veco, curpsp : Word);
      {-Patch vector entry point with JMP to previous controlling vector}
    label
      ExitPoint;
    var
      vec : ^Word;
      chg : Word;
    begin
      {Get the original vector from WATCH}
      Move(Mem[WatchPsp:(OrigVectors+(vecn shl 2))], vec, 4);

      {Scan the Changes array to look for redefinition of this vector}
      for chg := 0 to ChangeMax do begin
        with Changes[chg] do
          case ID of
            0, 1 :            {This is or was a redefined vector}
              if vecn = VecNum then
                {It's the vector we're interested in}
                {Store the latest value of the vector}
                Move(VecOfs, vec, 4);
            $FF :             {This record starts a new PSP}
              if PspAdd = curpsp then
                {Stop when we get to the PSP that is being disabled}
                goto ExitPoint;
          end;
      end;
ExitPoint:
      {Patch the vector entry point into a JMP FAR vec}
      Mem[vecs:veco] := $EA;
      Move(vec, Mem[vecs:Succ(veco)], 4);
    end;

    function CountVecs(chg : Word) : Word;
      {-Return count of vectors taken over by the PSP starting at changeblock chg}
    var
      count : Word;
      ID : Byte;
    begin
      count := 0;
      repeat
        {Skip over the first one, which defines the current PSP}
        inc(chg);
        ID := Changes[chg].ID;
        if (ID = 0) and (chg <= ChangeMax) then
          inc(count);
      until (ID = $FF) or (chg >= ChangeMax);
      CountVecs := count;
    end;

    function ValidToPatch(chg : Word) : Boolean;
      {-Assure that there is space to place 6-byte patches}
    var
      First : Word;
      Next : Word;
      I : Word;
      J : Word;
      IAddr : LongInt;
      JAddr : LongInt;
    begin
      ValidToPatch := True;
      if Override then
        Exit;

      {First vector to patch}
      First := chg+1;

      {Last vector to patch}
      Next := First;
      while (Next <= ChangeMax) and (Changes[Next].ID <> $FF) do
        inc(Next);

      {Any to patch?}
      if Next = First then
        Exit;

      {Compare each pair to assure enough space for patch}
      for I := First to Next-1 do begin
        with Changes[I] do
          IAddr := (LongInt(VecSeg) shl 4)+VecOfs;
        for J := First to Next-1 do
          if I <> J then begin
            with Changes[J] do
              JAddr := (LongInt(VecSeg) shl 4)+VecOfs;
            if Abs(IAddr-JAddr) < 6 then begin
              ValidToPatch := False;
              Exit;
            end;
          end;
      end;
    end;

  begin

    {Scan looking for the specified PSP}
    didsomething := False;
    watchindex := 0;

    for chg := 0 to ChangeMax do begin
      putrec := True;
      with Changes[chg] do
        case ID of

          $FF :               {This record starts a new PSP}
            begin
              checking := (PspAdd = PspHex);
              if checking then begin
                {Store the current PSP}
                curpsp := PspAdd;
                {Make sure WATCH has room for the extra changes}
                if watchindex+(CountVecs(chg)*SizeOf(ChangeBlock)) >
                MaxChanges*SizeOf(ChangeBlock) then
                  Abort('Insufficient space in WATCH data area', 255);
                {Make sure the patches will be valid}
                if not ValidToPatch(chg) then
                  Abort('Insufficient space between vectors to patch TSR', 255);
                {Turn off interrupts}
                inline($FA);
              end else
                {Turn on interrupts}
                inline($FB);
            end;

          $00 :               {This record has an active vector redefinition}
            if checking then begin
              {We're in the proper PSP}
              didsomething := True;

              {Change the ID to indicate that vector is inactive}
              ID := 1;
              {Output the record now so that the new record can immediately follow}
              PutWatch(Changes[chg], watchindex);
              putrec := False;

              {Output a new change record so we can reactivate later}
              {Indicate this is a patch record}
              newchange.ID := 2;
              {Save which vector it goes with}
              newchange.VecNum := VecNum;
              {Save the code we'll patch over}
              Move(Mem[VecSeg:VecOfs], newchange.SaveCode, 6);
              {Output the record to the WATCH area}
              PutWatch(newchange, watchindex);
              {Patch in a JMP to the previous vector}
              PutPatch(VecNum, VecSeg, VecOfs, curpsp);
            end;

        end;
      if putrec then
        {Put the change block back into WATCH}
        PutWatch(Changes[chg], watchindex);
    end;

    {Store the count back into WATCH}
    MemW[WatchPsp:NextChange] := watchindex;

    if not(didsomething) then
      Abort('No changes were needed to deactivate '+tsrname, 1);

  end;

  procedure CheckUpperLowerOptions;
    {-Set low and high memory options}
  var
    Arg : String[127];

    procedure GetArgs(S : String);
    var
      SPos : Word;
    begin
      SPos := 1;
      repeat
        Arg := StUpcase(NextArg(S, SPos));
        if Arg = '' then
          Exit;
        if (Arg = '-U') or (Arg = '/U') then
          UseHiMem := True
        else if (Arg = '-H') or (Arg = '/H') then
          OptUseHiMem := True
        else if (Arg = '-L') or (Arg = '/L') then
          UseLoMem := False;
      until False;
    end;

  begin
    UseHiMem := False;
    OptUseHiMem := False;
    UseLoMem := True;

    {Get arguments from the command line and the environment}
    GetArgs(StringPtr(Ptr(PrefixSeg, $80))^);
    GetArgs(GetEnv('DISABLE'));
  end;

  procedure GetOptions;
    {-Analyze command line for options}

    procedure WriteCopyright;
    begin
      WriteLn('DISABLE ', Version, ', Copyright 1991 TurboPower Software');
    end;

    procedure WriteHelp;
      {-Show the options}
    begin
      WriteCopyright;
      WriteLn;
      WriteLn('DISABLE allows you to selectively disable and reenable a TSR while leaving it');
      WriteLn('in memory. To run DISABLE, you must have previously installed the TSR utility');
      WriteLn('WATCH.');
      WriteLn;
      WriteLn('DISABLE is command-line driven. You specify a single TSR by its name (if you');
      WriteLn('are running DOS 3.0 or later) or by its address as determined from a MAPMEM');
      WriteLn('report. Addresses must be preceded by a dollar sign "$" and specified in hex.');
      WriteLn;
      WriteLn('DISABLE accepts the following command line syntax:');
      WriteLn;
      WriteLn('  DISABLE TSRname|$PSPaddress [Options]');
      WriteLn;
      WriteLn('Options may be preceded by either / or -. Valid options are as follows:');
      WriteLn;
      WriteLn('  /A         reactivate the specified TSR.');
      WriteLn('  /C         check whether TSR is installed.');
      WriteLn('  /H         work with upper memory if available.');
      WriteLn('  /O         disable the TSR even if dangerous.');
      WriteLn('  /Q         write no screen output.');
      WriteLn('  /U         work with upper memory, but halt if none found.');
      WriteLn('  /?         write this help screen.');
      Halt(1);
    end;

    function FindOwner(tname : String) : Word;
      {-Return segment of executable block with specified name}
    var
      b : BlockType;
      IsCmd : Boolean;
      M : McbPtr;
      Name : String[79];
    begin
      tname := StUpcase(tname);

      {Scan the blocks in reverse order}
      for b := BlockMax downto 1 do
        with Blocks[b] do
          if Succ(mcb) = psp then begin
            {This block is an executable block}
            IsCmd := (Psp = MemW[Psp:$16]);
            M := Ptr(Mcb, 0);
            if (not IsCmd) and (DosV > 2) and HasEnvironment(HiMemSeg, M) then
              Name := NameFromEnv(M)
            else if DosV >= 4 then
              Name := NameFromMcb(M)
            else if (not IsCmd) and (DosVT >= $031E) then
              Name := NameFromMcb(M)
            else
              Name := '';
            if StUpcase(Name) = tname then begin
              FindOwner := Psp;
              Exit;
            end;
          end;
      FindOwner := $FFFF;
    end;

    procedure GetArgs(S : String);
    var
      SPos : Word;
      Code : Word;
      Arg : String[127];
    begin
      SPos := 1;
      repeat
        Arg := NextArg(S, SPos);
        if Arg = '' then
          Exit;
        if (Arg[1] = '?') then
          WriteHelp
        else if (Arg[1] = '-') or (Arg[1] = '/') then
          case Length(Arg) of
            1 : Abort('Missing command option following '+Arg, 254);
            2 : case UpCase(Arg[2]) of
                  '?' : WriteHelp;
                  'A' : Action := aActivate;
                  'C' : Action := aCheckFor;
                  'E' : Action := aActivate;
                  'H' : ; {ignore, but allow, here}
                  'L' : ; {ignore, but allow, here}
                  'O' : Override := True;
                  'Q' : Quiet := True;
                  'U' : ; {ignore, but allow, here}
                else
                  Abort('Unknown command option: '+Arg, 254);
                end;
          else
            Abort('Unknown command option: '+Arg, 254);
          end
        else begin
          {TSR to change}
          if Arg[1] = '$' then begin
            {Treat as hex address}
            Val(Arg, PspHex, Code);
            if Code <> 0 then
              Abort('Invalid hex address specification: '+Arg, 254);
          end else if DosV >= 3 then
            {Treat as PSP owner name - scan to find proper PSP}
            PspHex := FindOwner(Arg)
          else
            Abort('Must have DOS 3.0+ to find TSRs by name', 254);
          TsrName := StUpcase(Arg);
        end;
      until False;
    end;

  begin
    {Initialize defaults}
    PspHex := 0;
    Action := aDeactivate;
    Override := False;
    Quiet := False;

    {Get arguments from the command line and the environment}
    GetArgs(StringPtr(Ptr(PrefixSeg, $80))^);
    GetArgs(GetEnv('DISABLE'));

    if not Quiet then
      WriteCopyright;
    if PspHex = 0 then
      Abort('No TSR name or address specified', 254)
    else if PspHex = $FFFF then
      Abort('Did not find '+TsrName, 2);
  end;

begin
  {$IFDEF MeasureStack}
  FillChar(Mem[SSeg:0], SPtr-16, $AA);
  {$ENDIF}

  {Determine whether upper memory control is desired}
  CheckUpperLowerOptions;

  {Initialize for high memory access}
  if not UseLoMem then
    OptUseHiMem := True;
  if OptUseHiMem or UseHiMem then begin
    HiMemSeg := FindHiMemStart;
    if HiMemSeg = 0 then begin
      if UseHiMem then
        Abort('No upper memory blocks found', 255);
    end else
      UseHiMem := True;
  end else
    HiMemSeg := 0;

  {Get all allocated memory blocks in normal memory}
  {Must do first to support TSRs by name in GetOptions}
  FindTheBlocks(UseLoMem, HiMemSeg, Blocks, BlockMax, StartMcb, CommandSeg);

  {Analyze command line for options}
  GetOptions;

  {Find the watch block}
  WatchPsp := WatchPspSeg;
  if WatchPsp = 0 then
    Abort('WATCH must be installed in order to use DISABLE', 255);

  {Assure PspHex corresponds to an executable block}
  if not ExecutableBlock(PspHex) then
    Abort('No such TSR found', 2);

  {Initialize information regarding the WATCH data block}
  InitChangeArray(WatchPsp);

  {Activate or deactivate the TSR}
  case Action of
    aDeactivate:DeactivateTSR(PspHex);
    aActivate:ActivateTSR(PspHex);
  end;

  {Write success message}
  if not Quiet then begin
    case Action of
      aDeactivate:Write('Deactivated');
      aActivate:Write('Activated');
      aCheckFor:Write('Found');
    end;
    Write(' ');
    if TsrName[1] = '$' then
      Write('TSR at ');
    WriteLn(TsrName);
  end;

  {$IFDEF MeasureStack}
  I := 0;
  while I < SPtr-16 do
    if Mem[SSeg:i] <> $AA then begin
      writeln('Unused stack ', i, ' bytes');
      I := SPtr;
    end else
      inc(I);
  {$ENDIF}
end.